﻿#VisualFreeBasic_Form#  Version=5.4.6
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW,CS_HREDRAW,CS_DBLCLKS
ClassName=模拟软件崩溃
WinStyle=WS_VISIBLE,WS_EX_CONTROLPARENT,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_BORDER,WS_CAPTION,WS_SYSMENU,WS_MAXIMIZEBOX,WS_MINIMIZEBOX,WS_CLIPSIBLINGS,WS_CLIPCHILDREN,WS_POPUP,WS_SIZEBOX
Style=3 - 常规窗口
Icon=
Caption=Cairo控件和SVG(只支持阿里云的SVG)测试
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=1024
Height=672
TopMost=False
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
Shadow=0 - 无阴影
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[ListBox]
Name=List1
Index=-1
Custom=
Style=0 - 单选
BStyle=3 - 凹边框
OwnDraw=0 - 系统绘制
ItemHeight=15
HasString=False
Sorted=False
NoHeight=True
MultiColumn=False
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,5
Font=微软雅黑,9,0
Left=720
Top=26
Width=286
Height=597
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Button]
Name=Command1
Index=-1
Caption=Command1
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=594
Top=306
Width=94
Height=27
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Cairo]
Name=Cairo1
Help=https://www.kancloud.cn/yongfang/visualfreebasic/1936049
Index=-1
Left=486
Top=454
Tag=

[Option]
Name=Option1
Index=0
Style=0 - 标准
Caption=使用Gdi画 SVG
TextAlign=3 - 中左对齐
Alignment=0 - 文本在左边
Value=1 - 选择
Multiline=True
GroupName=OptionGroup1
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9,0
Left=729
Top=6
Width=112
Height=18
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Option]
Name=Option1
Index=1
Style=0 - 标准
Caption=使用Cair画 SVG
TextAlign=3 - 中左对齐
Alignment=0 - 文本在左边
Value=0 - 未选择
Multiline=True
GroupName=OptionGroup1
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9,0
Left=863
Top=5
Width=112
Height=20
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False


[AllCode]

  

Sub Form1_Shown(hWndForm As hWnd, UserData As Integer)  '窗口完全显示后。UserData 来自显示窗口最后1个参数。
   
   Dim vi as OSVERSIONINFO
   vi.dwOsVersionInfoSize = SizeOf(OSVERSIONINFO)
   GetVersionEx @vi
   me.Caption =me.Caption & "  系统版本：" & vi.dwMajorVersion & "." & vi.dwMinorVersion
   Dim lName() As WIN32_FIND_DATAW, i As Long
   GetDIR(App.Path & "*.svg", lName())
   For i = 0 To UBound(lname)
      List1.AddItem lname(i).cFileName
   Next
   List1.ListIndex = 0

   
End Sub
Sub Form1_List1_LBN_SelChange(hWndForm As hWnd, hWndControl As hWnd)  '选择了列表
   Dim ii As Long = List1.ListIndex
   if ii = -1 Then Return
   
   Dim tt As ULong = GetTickCount
   if Option1(0).Value Then
      Dim gg As yGDI = hWndForm
      gg.Brush GetSysColor(COLOR_BTNFACE)
      gg.DrawFrame 0, 0 '
      SVG_DrawFile(App.Path & List1.List(ii), gg.m_Dc, 0, 0, 512, 512)
      gg.DrawString 5, 5, ii & " 本次绘画花费时间(毫秒)：" & GetTickCount - tt
   Else
      Dim DC As HDC = GetDC(hWndForm) '获取窗口DC
      Cairo1.WinDC = DC   '绑定DC
      Cairo1.Clear(GetSysColor(COLOR_BTNFACE))
      SVG_CairoDrawFile(App.Path & List1.List(ii), @Cairo1, 0, 0, 512, 512)
      Cairo1.SourceRGB 0
      Cairo1.MoveTo 5,20
      Cairo1.TextPath StrToUtf8(ii & " 本次绘画花费时间(毫秒)：" & GetTickCount - tt)
      Cairo1.DrawFill 
      Cairo1.Display '显示输出
      ReleaseDC hWndForm, DC  '销毁DC
   End if

   
End Sub

Function SVG_DrawFile(SVG_File As CWSTR, nDc As HDC, x As Long, y As Long, w As Long, h As Long) As Long  '描绘SVG文件(阿里云标准)， 成功返回 True ，失败 False
   'SVG格式非常复杂，目前只是支持 阿里云 https://www.iconfont.cn/ 矢量图库里的简化格式，只用来显示阿里云下载的SVG文件
   Dim SVGstr As String =GetFileStr(SVG_File)
   Function = SVG_Draw(SVGstr,nDc  ,x  ,y  ,w ,h  )
End Function

Function SVG_Draw(SVGstr As String, nDc As HDC, x As Long, y As Long, w As Long, h As Long) As Long  '描绘SVG 格式(阿里云标准) 成功返回 True ，失败 False
   'SVG格式非常复杂，目前只是支持 阿里云 https://www.iconfont.cn/ 矢量图库里的简化格式，只用来显示阿里云下载的SVG文件
   Dim f1 As Long = InStr(SVGstr, "viewBox="), f2 As Long
   if f1 = 0 Then Return False '无盒子，非SVG文件
   f2 = InStr(f1 + 1, SVGstr, """")
   if f2 = 0 Then Return False
   f1 = InStr(f2 + 1, SVGstr, """")
   if f1 = 0 Then Return False
   Dim ts As String = Mid(SVGstr, f2 + 1, f1 - f2 -1) '获取 viewBox
   Dim tsm() As String
   Dim u As Long = vbSplit(trim(ts), " ", tsm())
   if u <> 4 Then Return False '数据异常
   Dim As Single viewBoxW =Val(tsm(2))-Val(tsm(0)),viewBoxH = Val(tsm(3))-Val(tsm(1)),ax=x,ay=y
   viewBoxW = w / viewBoxW  'SVG盒子尺寸与输出比例
   viewBoxH = h / viewBoxH
   Dim hPen as HPEN = CreatePen(PS_SOLID, 1, 0) '   PS_NULL, 0, 0) '创建空轮廓笔，因为从来不需要轮廓
   Dim hOldPen as HGDIOBJ = SelectObject(nDc, hPen) '设置轮廓笔
   Dim hBrush as HBRUSH = CreateSolidBrush(0) '创建填充颜色
   Dim hOldBrush as HGDIOBJ = SelectObject(nDc, hBrush)
   Do
      f2 = InStr(f1 + 1, SVGstr, "<path ")
      if f2 = 0 Then Exit Do
      f1 = InStr(f2 + 6, SVGstr, "d=""")
      if f1 = 0 Then f1 = f2 + 6 : Continue Do
      f2 = InStr(f2 + 3, SVGstr, ">")
      if f2 = 0 Then Continue Do
      ts = Mid(SVGstr, f1 + 3, f2 - f1 -3) '获取一组 路径
      Dim cc As Long
      Dim f3 As Long = InStr(ts, "fill=""")
      if f3 Then
         Dim f4 As Long = InStr(f3 + 6, ts, """")
         if f4 Then
            cc = ValInt(YF_Replace(Mid(ts, f3 + 6, f4 - f3 -6), "#", "&H")) '获取填充颜色
            Dim ccu As UByte Ptr = Cast(Any Ptr, @cc)
            Swap ccu[0], ccu[2]   '网页颜色和 GDI 颜色 需要反过来。
         End if
      End if
      f3 = InStr(ts, """")
      if f3 Then ts = YF_Replace(Left(ts, f3 -1), vbCrLf, "")
      DeleteObject hBrush  '销毁上次使用的
      hBrush = CreateSolidBrush(cc) '重新创建填充
      SelectObject(nDc, hBrush)
      BeginPath(nDc) '开始路径
      Dim cs() As Single
      Dim hOlc As Long, hOlx As Single, hOly As Single  '参数 和上次命令（用于 s 命令）
      For i As Long = 0 To Len(ts) -1
         Select Case ts[i]
            Case 109 'm   “Move to”命令 ，只移动，不画  m dx dy
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 1 Then
                  ax += cs(0) *viewBoxW : ay += cs(1) *viewBoxH
                  MoveToEx nDc, ax, ay, null
               End if
            Case 77 'M       M x y
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 1 Then
                  ax = cs(0) *viewBoxW + x : ay = cs(1) *viewBoxH + y
                  MoveToEx(nDc, ax, ay, null)
               End if
            Case 108 'l   “Line to”命令 ，画线   l dx dy
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 1 Then
                  For ii As Long = 0 To UBound(cs) Step 2
                     if ii + 1 > UBound(cs) Then Exit For
                     ax += cs(ii) *viewBoxW : ay += cs(ii + 1) *viewBoxH
                     LineTo(nDc, ax, ay)
                  Next
               End if
            Case 76 'L                             L x y
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 1 Then
                  For ii As Long = 0 To UBound(cs) Step 2
                     if ii + 1 > UBound(cs) Then Exit For
                     ax = cs(ii) *viewBoxW + x : ay = cs(ii + 1) *viewBoxH + y
                     LineTo(nDc, ax, ay)
                  Next
               End if
            Case 104 'h    绘制水平线    H x (or h dx)
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 0 Then
                  For ii As Long = 0 To UBound(cs)
                     ax += cs(ii) *viewBoxW
                     LineTo(nDc, ax, ay)
                  Next
               End if
            Case 72 'H
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 0 Then
                  For ii As Long = 0 To UBound(cs)
                     ax = cs(ii) *viewBoxW + x
                     LineTo(nDc, ax, ay)
                  Next
               End if
            Case 118 'v    绘制垂直线   V y (or v dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 0 Then
                  For ii As Long = 0 To UBound(cs)
                     ay += cs(ii) *viewBoxH
                     LineTo(nDc, ax, ay)
                  Next
               End if
            Case 86 'V
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 0 Then
                  For ii As Long = 0 To UBound(cs)
                     ay = cs(ii) *viewBoxH + y
                     LineTo nDc, ax, ay
                  Next
               End if
            Case 99 'c     三次贝塞尔曲线C  C x1 y1, x2 y2, x y (or c dx1 dy1, dx2 dy2, dx dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 5 Then
                  Dim pt(2) As POINT
                  For ii As Long = 0 To UBound(cs) Step 6
                     if ii + 5 > UBound(cs) Then Exit For
                     pt(0).x = ax + cs(ii) *viewBoxW : pt(0).y = ay + cs(ii + 1) *viewBoxH
                     pt(1).x = ax + cs(ii + 2) *viewBoxW : pt(1).y = ay + cs(ii + 3) *viewBoxH
                     ax += cs(ii + 4) *viewBoxW : ay += cs(ii + 5) *viewBoxH
                     pt(2).x = ax : pt(2).y = ay
                     hOlx = pt(1).x : hOly = pt(1).y '给 S命令用
                     PolyBezierto nDc, @pt(0), 3
                  Next
               End if
            Case 67 'C
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 5 Then
                  Dim pt(2) As POINT
                  For ii As Long = 0 To UBound(cs) Step 6
                     if ii + 5 > UBound(cs) Then Exit For
                     pt(0).x = cs(ii) *viewBoxW + x : pt(0).y = cs(ii + 1) *viewBoxH + y
                     pt(1).x = cs(ii + 2) *viewBoxW + x : pt(1).y = cs(ii + 3) *viewBoxH + y
                     ax = cs(ii + 4) *viewBoxW + x : ay = cs(ii + 5) *viewBoxH + y
                     pt(2).x = ax : pt(2).y = ay
                     hOlx = pt(1).x : hOly = pt(1).y '给 S命令用
                     PolyBezierto nDc, @pt(0), 3
                  Next
               End if
            Case 115 's   S贝塞尔曲线  S x2 y2, x y (or s dx2 dy2, dx dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 3 Then
                  Dim pt(2) As POINT
                  For ii As Long = 0 To UBound(cs) Step 4
                     if ii + 3 > UBound(cs) Then Exit For
                     pt(1).x = ax + cs(ii) *viewBoxW : pt(1).y = ay + cs(ii + 1) *viewBoxH
                     if hOlc = 99 Or hOlc = 67 Or hOlc = 115 Or hOlc = 83 Then
                        pt(0).x = (ax - hOlx) + ax : pt(0).y = (ay - hOly) + ay
                     Else
                        pt(0).x = pt(1).x : pt(0).y = pt(1).y '如果S命令单独使用，前面没有C命令或者另一个S命令，那么它的两个控制点就会被假设为同一个点。
                     End if
                     ax += cs(ii + 2) *viewBoxW : ay += cs(ii + 3) *viewBoxH
                     pt(2).x = ax : pt(2).y = ay
                     hOlx = pt(1).x : hOly = pt(1).y '给 S命令用
                     PolyBezierto nDc, @pt(0), 3
                  Next
               End if
            Case 83 'S
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 3 Then
                  Dim pt(2) As POINT
                  For ii As Long = 0 To UBound(cs) Step 4
                     if ii + 3 > UBound(cs) Then Exit For
                     pt(1).x = cs(ii) *viewBoxW : pt(1).y = cs(ii + 1) *viewBoxH
                     if hOlc = 99 Or hOlc = 67 Or hOlc = 115 Or hOlc = 83 Then
                        pt(0).x = (ax - hOlx) + ax : pt(0).y = (ay - hOly) + ay
                     Else
                        pt(0).x = pt(1).x : pt(0).y = pt(1).y '如果S命令单独使用，前面没有C命令或者另一个S命令，那么它的两个控制点就会被假设为同一个点。
                     End if
                     ax = cs(ii + 2) *viewBoxW : ay = cs(ii + 3) *viewBoxH
                     pt(2).x = ax : pt(2).y = ay
                     hOlx = pt(1).x : hOly = pt(1).y '给 S命令用
                     PolyBezierto nDc, @pt(0), 3
                  Next
               End if
            Case 113 'q     二次贝塞尔曲线Q  Q x1 y1, x y (or q dx1 dy1, dx dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 81 'Q
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 116 't     延长二次贝塞尔曲线  T x y (or t dx dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 84 'T
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 97 'a      弧形  a x轴半径 y轴半径 弧形旋转 角度大小 弧线方向 dx dy
               hOlc = ts[i] '保存上次命令，用于s 命令
               '弧形旋转
               '角度大小 弧线是大于还是小于180度，0表示小角度弧，1表示大角度弧。
               '弧线方向 0表示从起点到终点沿逆时针画弧，1表示从起点到终点沿顺时针画弧。
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 6 Then
                  Dim As Single rx,ry,zx,zy ,qx,qy
                  For ii As Long = 0 To UBound(cs) Step 7
                     if ii + 6 > UBound(cs) Then Exit For
                     SetArcDirection nDc, IIf(cs(ii + 4), AD_CLOCKWISE, AD_COUNTERCLOCKWISE) '弧线方向
                     zx = cs(ii + 5) *viewBoxW + ax : zy = cs(ii + 6) *viewBoxH + ay  '弧终点
                     if SVG_path_ellipse(ax, ay, zx, zy, cs(ii) *viewBoxW, cs(ii + 1) *viewBoxH, cs(ii + 2), cs(ii + 3), cs(ii + 4), rx, ry) Then
                        
                        ArcTo nDc, rx-cs(ii) *viewBoxW, ry-cs(ii)  *viewBoxW, rx + cs(ii) *viewBoxW, ry + cs(ii + 1) *viewBoxH, ax, ay, zx, zy
                     End if
                     ax = zx : ay = zy
                     'LineTo nDc, ax, ay
                  Next
               End if
            Case 65 'A    A rx ry x-axis-rotation large-arc-flag sweep-flag x y
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 90, 122 'Z z   闭合路径命令
               hOlc = ts[i] '保存上次命令，用于s 命令
               
         End Select
      Next
      EndPath(nDc)
      FillPath(nDc)
      
      f1 = f2 + 1
      
   Loop
   
   SelectObject nDc, hOldBrush '恢复
   DeleteObject hBrush
   SelectObject(nDc, hOldPen)  '还原笔
   DeleteObject hPen '销毁笔
   
   
End Function

Sub SVG_path_parameter(ByRef i As Long, ts As String, cs() As Single)  '获取参数
   Dim u As Long = Len(ts) -1
   ReDim cs(100)
   Dim ss As String, ki As Long
'   PrintA i,ts 
   Do
      i += 1
      if i > u Then Exit Do
      Select Case ts[i]
         Case 45,44, 32 '- , 和空格 表示参数分隔   
            if Len(ss) Then
               if ki > UBound(cs) Then ReDim Preserve cs(ki + 10)
               cs(ki) = Val(ss)
               ki += 1
            End if
            if ts[i] = 45 Then ss = "-" Else ss = ""
         Case 48 To 57 ,46  '数字
            ss &= Chr(ts[i])
         Case Else    '遇到其它字符，结束
            if Len(ss) Then
               if ki > UBound(cs) Then ReDim Preserve cs(ki + 10)
               cs(ki) = Val(ss)
               ss = ""
               ki += 1
            End if
            i -= 1   '需要减少1个，返回后，循环才可以
            Exit Do
      End Select
   Loop
   if Len(ss) Then   '有参数
      if ki > UBound(cs) Then ReDim Preserve cs(ki + 10)
      cs(ki) = Val(ss)
      ki += 1
   End if
   if ki = 0 Then Erase cs Else ReDim Preserve cs(ki -1)
'   PrintA UBound(cs)
End Sub
#Include Once "crt\math.bi"
Function SVG_path_ellipse(FStartX As Single, FStartY As Single, FStopX As Single, FStopY As Single, FRX As Single, FRY As Single, FXRot As Single, FLarge As Long, FSweep As Long, ByRef rx As Single, ByRef ry As Single,ByRef AngleStart As Single=0 ,ByRef AngleExtent As Single =0) As Long  '算出 椭圆 位置 ，失败返回0
   'FStartX  FStartY  当前点
   'FStopX   FStopX   终点
   'FRX  FRY 椭圆 x轴半径 y轴半径
   'FXRot  弧形旋转
   'FLarge 角度大小 弧线是大于还是小于180度，0表示小角度弧，1表示大角度弧。
   'FSweep 弧线方向 0表示从起点到终点沿逆时针画弧，1表示从起点到终点沿顺时针画弧。
'   PrintA FXRot,FLarge,FSweep
   if (FStartX = FStopX) and (FStartY = FStopY) then Return 0
   
   if (FRX = 0) or (FRY = 0) then Return 0
   
   '基于SVG规范注释的椭圆弧实现
   
   '计算当前点和终点之间的一半距离
   Dim DX2 As Single = (FStartX - FStopX) / 2.0
   Dim DY2 As Single = (FStartY - FStopY) / 2.0
   
   '将角度从度转换为弧度
   Dim Angle As Single = DegToRad(FMod(FXRot, 360))
   Dim cosAngle As Single = cos(Angle)
   Dim sinAngle As Single = sin(Angle)
   'Step 1 : 计算 (x1, y1)
   Dim x1 As Single = (cosAngle * DX2 + sinAngle * DY2)
   Dim y1 As Single = ( - sinAngle * DX2 + cosAngle * DY2)
   '确保半径足够大
   Dim LRX As Single = abs(Frx)
   Dim LRY As Single = abs(Fry)
   Dim Prx As Single = LRX * LRX
   Dim Pry As Single = LRY * LRY
   Dim Px1 As Single = x1 * x1
   Dim Py1 As Single = y1 * y1
   '检查半径是否足够大
   Dim RadiiCheck As Single = Px1 / Prx + Py1 / Pry
   if (RadiiCheck > 1) then
      LRX = sqrt(RadiiCheck) * LRX
      LRY = sqrt(RadiiCheck) * LRY
      Prx = LRX * LRX
      Pry = LRY * LRY
   End If
   'Step 2 : Compute (cx1, cy1)
   Dim sign As Single = iif(FLarge = FSweep, -1, 1)
   Dim Sq As Single = ((Prx * Pry) - (Prx * Py1) - (Pry * Px1)) / ((Prx * Py1) + (Pry * Px1))
   Sq = iif(Sq < 0, 0.0, Sq)
   Dim Coef As Single = (sign * sqrt(Sq))
   Dim CX1 As Single = Coef * ((LRX * y1) / LRY)
   Dim CY1 As Single = Coef * - ((LRY * x1) / LRX)
   'Step 3 : Compute (cx, cy) from (cx1, cy1)
   Dim sx2 As Single = (FStartX + FStopX) / 2.0
   Dim sy2 As Single = (FStartY + FStopY) / 2.0
   Dim cx As Single = sx2 + (cosAngle * CX1 - sinAngle * CY1)
   Dim cy As Single = sy2 + (sinAngle * CX1 + cosAngle * CY1)
   '步骤4：计算angleStart（angle1）和angleExtent（dangle）
   Dim ux As Single = (x1 - CX1) / LRX
   Dim uy As Single = (y1 - CY1) / LRY
   Dim vx As Single = ( - x1 - CX1) / LRX
   Dim vy As Single = ( - y1 - CY1) / LRY
   '计算角度起点
   Dim n As Single = (ux * ux) + (uy * uy)
   n = sqrt(n)
   Dim p As Single = ux '
   sign = iif(uy < 0, -1, 1)
   AngleStart = RadToDeg(sign * Acos(p / n))
   '计算角度范围
   n = sqrt((ux * ux + uy * uy) * (vx * vx + vy * vy))
   p = ux * vx + uy * vy
   sign = iif(ux * vy - uy * vx < 0, -1, 1)
   AngleExtent = RadToDeg(sign * Acos(p / n))

   if ((Fsweep = 0) and (AngleExtent > 0)) then
      AngleExtent = AngleExtent - 360
   elseif ((FSweep = 1) and (AngleExtent < 0)) then
      AngleExtent = AngleExtent + 360
   endif
   AngleStart = FMod(AngleStart, 360)
   AngleExtent = FMod(AngleExtent, 360)   
   Rx = cx '- LRX
   Ry = cy '- LRY
   Function = 1
End Function
 
Function DegToRad(Deg As Single ) As Single  '将角度从度数转换为弧度
   Function = Deg * (3.1415926 /180 )
End Function
Function RadToDeg(Rad As Single) As Single  '将角度从弧度转换为度数
   Function = Rad * 180 / 3.1415926
End Function

Sub Form1_Command1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Dim tt As ULong = GetTickCount
   Dim DC As HDC = GetDC(hWndForm) '获取窗口DC
   Cairo1.WinDC = DC   '绑定DC
   '一系列画画-----------------------------
   Cairo1.Clear(GetSysColor(COLOR_BTNFACE) )
   Dim As Single centre_x=100, centre_y=100
'   
'   '就是设置路径线
'
'   Cairo1.SourceRGB(&H0000FF)
'   Cairo1.LineWidth = 2
'   Cairo1.MoveTo(centre_x, centre_y)
'   Cairo1.LineTo(centre_x + 200, centre_y)
'   Cairo1.LineTo(centre_x + 200, centre_y + 30)
'   Cairo1.DrawStroke
   
         
   'cairo_identity_matrix Cairo1.CairoHandle
   
   
'   Cairo1.MoveTo(centre_x, centre_y)
'   Cairo1.LineTo(centre_x + 200, centre_y)
'   Cairo1.LineTo(centre_x + 200, centre_y + 30)
'   Cairo1.DrawStroke
   
   '' Cairo1.DrawPNG("FreeBasic.png", 50, 20)
'   Cairo1.SourceRGB(&HFF0000 )
'   'Cairo1.LineWidth = 2
'   ''
'   For i As Long = 10 To 90 Step 10
'
'      Cairo1.Rotate centre_x+100, centre_y+100,i
'      'Cairo1.DrawPNG("FreeBasic.png", 50, 20)
'      '
'      'Cairo1.DrawPNG("FreeBasic.png", 50, 250)
'      
'      
''      Cairo1.MoveTo(centre_x, centre_y)
''      Cairo1.LineTo(centre_x + 200, centre_y)
''      Cairo1.LineTo(centre_x + 200, centre_y + 30)
''      Cairo1.DrawStroke
'      'cairo_translate Cairo1.CairoHandle ,-10, -10
'      'cairo_rotate Cairo1.CairoHandle,  -i * (3.1415926 / 180)
'      Cairo1.DrawPNG("FreeBasic.png", 50, 20)
'      
'   Next
   'Cairo1.SourceRadialRGB(&H00FF00,150,150,0,&H0000FF,150,150,50)
   ''Cairo1.Rectangle(50, 50, 550 ,500 )
   'Cairo1.Rectangle(50, 50, 300 ,300 )
   
   
   'Cairo1.FontFace StrToUtf8("黑体"),CAIRO_FONT_SLANT_OBLIQUE,CAIRO_FONT_WEIGHT_NORMAL
   'Cairo1.FontSize 200
   'Cairo1.TextPath(StrToUtf8("dW定位18"))
   
   
   '设置填充
   
   
   
   'Cairo1.DrawFillPreserve
   '设置线条
   'Cairo1.Caps(CAIRO_LINE_CAP_ROUND)
   'Cairo1.Join(CAIRO_LINE_JOIN_ROUND)
   
   'Cairo1.SourceRGB(&HFF0000 )
   'Cairo1.LineWidth = 2
   'Cairo1.DrawStroke
   
   'Cairo1.DrawPNG("FreeBasic.png", 50, 250)
   '画画完成 -------------------------------
   Cairo1.Display '显示输出
   ReleaseDC hWndForm, DC  '销毁DC
   
   PrintA GetTickCount - tt
End Sub

Function SVG_CairoDrawFile(SVG_File As CWSTR, Cairo As Class_Cairo Ptr, x As Long, y As Long, w As Long, h As Long) As Long  '描绘SVG文件(阿里云标准)， 成功返回 True ，失败 False
   'SVG格式非常复杂，目前只是支持 阿里云 https://www.iconfont.cn/ 矢量图库里的简化格式，只用来显示阿里云下载的SVG文件
   Dim SVGstr As String =GetFileStr(SVG_File)
   Function = SVG_CairoDraw(SVGstr,Cairo  ,x  ,y  ,w ,h  )
End Function

Function SVG_CairoDraw(SVGstr As String, Cairo As Class_Cairo Ptr, x As Long, y As Long, w As Long, h As Long) As Long  '描绘SVG 格式(阿里云标准) 成功返回 True ，失败 False
   'SVG格式非常复杂，目前只是支持 阿里云 https://www.iconfont.cn/ 矢量图库里的简化格式，只用来显示阿里云下载的SVG文件
   Dim f1 As Long = InStr(SVGstr, "viewBox="), f2 As Long
   if f1 = 0 Then Return False '无盒子，非SVG文件
   f2 = InStr(f1 + 1, SVGstr, """")
   if f2 = 0 Then Return False
   f1 = InStr(f2 + 1, SVGstr, """")
   if f1 = 0 Then Return False
   Dim ts As String = Mid(SVGstr, f2 + 1, f1 - f2 -1) '获取 viewBox
   Dim tsm() As String
   Dim u As Long = vbSplit(trim(ts), " ", tsm())
   if u <> 4 Then Return False '数据异常
   Dim As Single viewBoxW =Val(tsm(2))-Val(tsm(0)),viewBoxH = Val(tsm(3))-Val(tsm(1)),ax=x,ay=y
   viewBoxW = w / viewBoxW  'SVG盒子尺寸与输出比例
   viewBoxH = h / viewBoxH
   
   Do
      f2 = InStr(f1 + 1, SVGstr, "<path ")
      if f2 = 0 Then Exit Do
      f1 = InStr(f2 + 6, SVGstr, "d=""")
      if f1 = 0 Then f1 = f2 + 6 : Continue Do
      f2 = InStr(f2 + 3, SVGstr, ">")
      if f2 = 0 Then Continue Do
      ts = Mid(SVGstr, f1 + 3, f2 - f1 -3) '获取一组 路径
      Dim cc As Long
      Dim f3 As Long = InStr(ts, "fill=""")
      if f3 Then
         Dim f4 As Long = InStr(f3 + 6, ts, """")
         if f4 Then
            cc = ValInt(YF_Replace(Mid(ts, f3 + 6, f4 - f3 -6), "#", "&H")) '获取填充颜色
            Dim ccu As UByte Ptr = Cast(Any Ptr, @cc)
            Swap ccu[0], ccu[2]   '网页颜色和 GDI 颜色 需要反过来。
         End if
      End if
      f3 = InStr(ts, """")
      if f3 Then ts = YF_Replace(Left(ts, f3 -1), vbCrLf, "")
      Cairo->SourceRGB(cc)
      
      Dim cs() As Single
      Dim hOlc As Long, hOlx As Single, hOly As Single  '参数 和上次命令（用于 s 命令）
      For i As Long = 0 To Len(ts) -1
         Select Case ts[i]
            Case 109 'm   “Move to”命令 ，只移动，不画  m dx dy
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 1 Then
                  ax += cs(0) *viewBoxW : ay += cs(1) *viewBoxH
                  'MoveToEx nDc, ax, ay, null
                  Cairo->MoveTo ax, ay
               End if
            Case 77 'M       M x y
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 1 Then
                  ax = cs(0) *viewBoxW + x : ay = cs(1) *viewBoxH + y
                  'MoveToEx(nDc, ax, ay, null)
                  Cairo->MoveTo ax, ay
               End if
            Case 108 'l   “Line to”命令 ，画线   l dx dy
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 1 Then
                  For ii As Long = 0 To UBound(cs) Step 2
                     if ii + 1 > UBound(cs) Then Exit For
                     ax += cs(ii) *viewBoxW : ay += cs(ii + 1) *viewBoxH
                     'LineTo(nDc, ax, ay)
                     Cairo->LineTo ax, ay
                  Next
               End if
            Case 76 'L                             L x y
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 1 Then
                  For ii As Long = 0 To UBound(cs) Step 2
                     if ii + 1 > UBound(cs) Then Exit For
                     ax = cs(ii) *viewBoxW + x : ay = cs(ii + 1) *viewBoxH + y
                     'LineTo(nDc, ax, ay)
                     Cairo->LineTo ax, ay
                  Next
               End if
            Case 104 'h    绘制水平线    H x (or h dx)
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 0 Then
                  For ii As Long = 0 To UBound(cs)
                     ax += cs(ii) *viewBoxW
                     'LineTo(nDc, ax, ay)
                     Cairo->LineTo ax, ay
                  Next
               End if
            Case 72 'H
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 0 Then
                  For ii As Long = 0 To UBound(cs)
                     ax = cs(ii) *viewBoxW + x
                     'LineTo(nDc, ax, ay)
                     Cairo->LineTo ax, ay
                  Next
               End if
            Case 118 'v    绘制垂直线   V y (or v dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 0 Then
                  For ii As Long = 0 To UBound(cs)
                     ay += cs(ii) *viewBoxH
                     'LineTo(nDc, ax, ay)
                     Cairo->LineTo ax, ay
                  Next
               End if
            Case 86 'V
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 0 Then
                  For ii As Long = 0 To UBound(cs)
                     ay = cs(ii) *viewBoxH + y
                     'LineTo nDc, ax, ay
                     Cairo->LineTo ax, ay
                  Next
               End if
            Case 99 'c     三次贝塞尔曲线C  C x1 y1, x2 y2, x y (or c dx1 dy1, dx2 dy2, dx dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 5 Then
                  Dim pt(2) As POINT
                  For ii As Long = 0 To UBound(cs) Step 6
                     if ii + 5 > UBound(cs) Then Exit For
                     pt(0).x = ax + cs(ii) *viewBoxW : pt(0).y = ay + cs(ii + 1) *viewBoxH
                     pt(1).x = ax + cs(ii + 2) *viewBoxW : pt(1).y = ay + cs(ii + 3) *viewBoxH
                     ax += cs(ii + 4) *viewBoxW : ay += cs(ii + 5) *viewBoxH
                     pt(2).x = ax : pt(2).y = ay
                     hOlx = pt(1).x : hOly = pt(1).y '给 S命令用
                     Cairo->CurveTo(pt(0).x, pt(0).y, pt(1).x, pt(1).y, ax, ay)
                  Next
               End if
            Case 67 'C
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 5 Then
                  Dim pt(2) As POINT
                  For ii As Long = 0 To UBound(cs) Step 6
                     if ii + 5 > UBound(cs) Then Exit For
                     pt(0).x = cs(ii) *viewBoxW + x : pt(0).y = cs(ii + 1) *viewBoxH + y
                     pt(1).x = cs(ii + 2) *viewBoxW + x : pt(1).y = cs(ii + 3) *viewBoxH + y
                     ax = cs(ii + 4) *viewBoxW + x : ay = cs(ii + 5) *viewBoxH + y
                     pt(2).x = ax : pt(2).y = ay
                     hOlx = pt(1).x : hOly = pt(1).y '给 S命令用
                     'PolyBezierto nDc, @pt(0), 3
                     Cairo->CurveTo(pt(0).x, pt(0).y, pt(1).x, pt(1).y, ax, ay)
                  Next
               End if
            Case 115 's   S贝塞尔曲线  S x2 y2, x y (or s dx2 dy2, dx dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 3 Then
                  Dim pt(2) As POINT
                  For ii As Long = 0 To UBound(cs) Step 4
                     if ii + 3 > UBound(cs) Then Exit For
                     'Cairo->MoveTo ax,ay
                     pt(1).x = ax + cs(ii) *viewBoxW : pt(1).y = ay + cs(ii + 1) *viewBoxH
                     if hOlc = 99 Or hOlc = 67 Or hOlc = 115 Or hOlc = 83 Then
                        pt(0).x = (ax - hOlx) + ax : pt(0).y = (ay - hOly) + ay
                     Else
                        pt(0).x = pt(1).x : pt(0).y = pt(1).y '如果S命令单独使用，前面没有C命令或者另一个S命令，那么它的两个控制点就会被假设为同一个点。
                     End if
                     ax += cs(ii + 2) *viewBoxW : ay += cs(ii + 3) *viewBoxH
                     pt(2).x = ax : pt(2).y = ay
                     hOlx = pt(1).x : hOly = pt(1).y '给 S命令用
                     'PolyBezierto nDc, @pt(0), 3
                     Cairo->CurveTo(pt(0).x, pt(0).y, pt(1).x, pt(1).y, ax, ay)
                  Next
               End if
            Case 83 'S
               hOlc = ts[i] '保存上次命令，用于s 命令
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 3 Then
                  Dim pt(2) As POINT
                  For ii As Long = 0 To UBound(cs) Step 4
                     if ii + 3 > UBound(cs) Then Exit For
                     'Cairo->MoveTo ax,ay
                     pt(1).x = cs(ii) *viewBoxW : pt(1).y = cs(ii + 1) *viewBoxH
                     if hOlc = 99 Or hOlc = 67 Or hOlc = 115 Or hOlc = 83 Then
                        pt(0).x = (ax - hOlx) + ax : pt(0).y = (ay - hOly) + ay
                     Else
                        pt(0).x = pt(1).x : pt(0).y = pt(1).y '如果S命令单独使用，前面没有C命令或者另一个S命令，那么它的两个控制点就会被假设为同一个点。
                     End if
                     ax = cs(ii + 2) *viewBoxW : ay = cs(ii + 3) *viewBoxH
                     pt(2).x = ax : pt(2).y = ay
                     hOlx = pt(1).x : hOly = pt(1).y '给 S命令用
                     'PolyBezierto nDc, @pt(0), 3
                     Cairo->CurveTo(pt(0).x, pt(0).y, pt(1).x, pt(1).y, ax, ay)
                  Next
               End if
            Case 113 'q     二次贝塞尔曲线Q  Q x1 y1, x y (or q dx1 dy1, dx dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 81 'Q
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 116 't     延长二次贝塞尔曲线  T x y (or t dx dy)
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 84 'T
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 97 'a      弧形  a x轴半径 y轴半径 弧形旋转 角度大小 弧线方向 dx dy
               hOlc = ts[i] '保存上次命令，用于s 命令
               '弧形旋转
               '角度大小 弧线是大于还是小于180度，0表示小角度弧，1表示大角度弧。
               '弧线方向 0表示从起点到终点沿逆时针画弧，1表示从起点到终点沿顺时针画弧。
               SVG_path_parameter(i, ts, cs())  '获取参数
               if UBound(cs) >= 6 Then
                  Dim As Single rx,ry,zx,zy ,qx,qy ,   AngleStart , AngleExtent
                  For ii As Long = 0 To UBound(cs) Step 7
                     if ii + 6 > UBound(cs) Then Exit For
                     'Cairo->MoveTo ax,ay
                     'SetArcDirection nDc, IIf(cs(ii + 4), AD_CLOCKWISE, AD_COUNTERCLOCKWISE) '弧线方向
                     
                     zx = cs(ii + 5) *viewBoxW + ax : zy = cs(ii + 6) *viewBoxH + ay  '弧终点
                     if SVG_path_ellipse(ax, ay, zx, zy, cs(ii) *viewBoxW, cs(ii + 1) *viewBoxH, cs(ii + 2), cs(ii + 3), cs(ii + 4), rx, ry, AngleStart, AngleExtent) Then
                        
                        'PrintA rx, ry, cs(ii) *viewBoxW, cs(ii + 1) *viewBoxH,AngleStart, AngleExtent,cs(ii + 2),cs(ii + 4)
                        if cs(ii + 2) <> 0 Then 
                           Cairo->Rotate(rx, ry, cs(ii + 2))
                        End if 
                        AngleExtent += cs(ii + 2)
                        'PrintA AngleStart, AngleExtent
                        Cairo->Arc(rx, ry, cs(ii) *viewBoxW, cs(ii + 1) *viewBoxH, AngleExtent, AngleStart, cs(ii + 4))
                        Cairo->Rotate(rx, ry, 0)
                        'ArcTo nDc, rx, ry, rx + cs(ii) * 2 *viewBoxW, ry + cs(ii + 1) * 2 *viewBoxH, ax, ay, zx, zy
                     End if
                     ax = zx : ay = zy
                     'LineTo nDc, ax, ay
                  Next
               End if
            Case 65 'A    A rx ry x-axis-rotation large-arc-flag sweep-flag x y
               hOlc = ts[i] '保存上次命令，用于s 命令
            Case 90, 122 'Z z   闭合路径命令
               hOlc = ts[i] '保存上次命令，用于s 命令
               Cairo1.ClosePath
         End Select
      Next
      
      Cairo->DrawFill
      'Cairo->SourceRGB 0
      'Cairo->LineWidth = 1
      'Cairo->DrawStroke
      f1 = f2 + 1
      
   Loop
   
   
   
End Function













































































































